unit UGraph;

interface

uses
  Windows, Graphics, Classes, SysUtils, controls,
  // Sergroj aka Grayface units
  rsdef, rssysutils,
  // Self-made units
  Ucommon;

type
  TRGBArray = array[0..32767] of TRGBTriple;
  PRGBArray = ^TRGBArray;
  TDevice = HDC;
const
  transCol = $FFFF00;
  terCount = 9;
  rivCount = 4;
  roadCount = 3;

procedure Bmptrans(aBmp: TBmp; atransCol: Cardinal = transCol);
function flip(const b: TBmp; ver, hor: boolean): TBmp;
procedure Init(acanv: TDevice; aHeight, aWidth: word);
procedure Render({hDest, }hcanvas: THandle);
function MatchCol(rgbt: trgbtriple; Col: TColor): Boolean;
procedure DefToImglst(defPath: string; Imglst: timagelist);
procedure copyrect(canvdest, canvsrc: TCanvas; rectdest, rectsrc: TRect);



var
  roadCol: array[1..roadCount] of tColor = ($234567, $999999, $222222);
  rivCol: array[1..rivCount] of tColor = ($990000, $FFFFFF, $336699, $000099);
  terColar: array[0..terCount] of tColor =
    ($0F3F50, $8FCFDF, $004000, $C0C0B0, $6F804F, $307080, $003080, $4F4F4F,
    $90500F, $0);

implementation

uses Types;
var
  wndCanv: TDevice;
  WndWidth, WndHeight: word;
  defwraper: trsdefwrApper;
  FBuffer: TRSByteArray;
  //------------------------------------------------------------------------------

procedure DefToImglst(defPath: string; Imglst: timagelist);
var
  i: integer;
  ms: tmemorystream;
  aBmp, tmp: TBmp;
  MoveRect, CutRect: TRect;
  NeedsCut: Boolean;
  DefSize: TPoint;
begin
  Assert(Imglst <> nil, strnoImglst + defPath);
  Assert(FileExists(defPath), Format(strnoFile, [defPath]));
  ms := TMemoryStream.create;
  aBmp := TBmp.Create;
  tmp := Tbmp.Create;
  NeedsCut := False;
  try
    ms.LoadFromFile(defPath);
    Setlength(FBuffer, ms.size);
    CopyMemory(@FBuffer[0], ms.Memory, ms.size);
    defwraper := trsdefwrApper.Create(FBuffer);
    try
      for i := 0 to defwraper.PicturesCount - 1 do
        with defwraper.GetPicHeader(i)^ do
        begin
          if i = 0 then
          begin
            DefSize := Point(Width, Height);
            NeedsCut := (Width <> FrameWidth) and (Height <> FrameHeight);
            if not NeedsCut then
              Break;
            CutRect := rect(FrameLeft, FrameTop, FrameLeft + FrameWidth,
              FrameTop + FrameHeight);
          end;
          CutRect.Left := min(FrameLeft, CutRect.Left);
          CutRect.Top := min(FrameTop, CutRect.Top);
          CutRect.Right := max(FrameLeft + FrameWidth, CutRect.Right);
          CutRect.Bottom := max(FrameTop + FrameHeight, CutRect.Top);
        end;
      if NeedsCut then
      begin
        Imglst.Width := CutRect.Right - CutRect.Left;
        Imglst.Height := CutRect.Bottom - CutRect.Top;
        tmp.Width := Imglst.Width;
        tmp.Height := Imglst.Height;
        Moverect := CutRect;
        OffsetRect(MoveRect, -MoveRect.Left, -MoveRect.Top);
      end
      else
      begin
        Imglst.Width := Defsize.X;
        Imglst.Height := Defsize.Y;
      end;
      for i := 0 to defwraper.PicturesCount - 1 do
      begin
        defwraper.ExtractBmp(i, aBmp);
        if NeedsCut then
        begin
          CopyRect(tmp.Canvas, abmp.Canvas, MoveRect, CutRect);
          Imglst.Add(tmp, nil)
        end
        else
          Imglst.Add(aBmp, nil);
      end;
    finally
      FreeAndNil(defwraper);
    end;
  finally
    FreeAndNil(ms);
    FreeAndNil(tmp);
    FreeAndNil(aBmp);
  end;
end;

//------------------------------------------------------------------------------

{
procedure LoAddefs(aPath: string);
var
  i, z: integer;
  ms: tmemorystream;
begin
  for z := 0 to terCount do
  begin
    ms := TMemoryStream.create;
    try
      ms.LoadFromFile(aPath + terDefs[z] + defext);
      Setlength(FBuffer, ms.size);
      CopyMemory(@FBuffer[0], ms.Memory, ms.size);
      BmpLoad(FBuffer, z, def_ter);
    finally
      FreeAndNil(ms);
    end;
  end;
  {for z := 1 to rivCount
    do begin
    f := tFilestream.create(BmpPath+rivDefs[z]+defext, fmopenread) ;
    if f = nil
      then begin
      FreeAndNil(f) ;
      continue;
      end;
    Setlength(FBuffer,f.size) ;
    for i := 0 to f.Size-1
      do f.Read(FBuffer[i],1) ;
    BmpLoad(FBuffer,z,def_riv) ;
    FreeAndNil(f) ;
    end ;
  for z := 1 to roadCount
    do begin
    f := tFilestream.create(BmpPath+roAddefs[z]+defext, fmopenread) ;
    if f = nil
      then begin
      FreeAndNil(f) ;
      continue;
      end;
    Setlength(FBuffer,f.size) ;
    for i := 0 to f.Size-1
      do f.Read(FBuffer[i],1) ;
    BmpLoad(FBuffer,z,def_road) ;
    FreeAndNil(f) ;
    end ;
end;
}

// Gets all images from Defs

{procedure BmpLoad(buf: TRSByteArray; ind, deftype: byte);
var
  i, j: byte;
  Bmp: TBmp;
begin
  try
    Bmp := TBmp.Create;
    defwraper := trsdefwrApper.Create(buf);
    if defwraper.picturesCount > 0 then
      j := defwraper.picturesCount - 1
    else
      exit;
    for i := 0 to j do
    begin
      defwraper.ExtractBmp(i, Bmp);
      case deftype of
        def_ter:
          begin
            terBmps[ind, i] := TBmp.Create;
            terBmps[ind, i].assign(Bmp);
          end;
        def_riv:
          begin
            rivBmps[ind, i] := TBmp.Create;
            rivBmps[ind, i].assign(Bmp);
            Bmptrans(rivBmps[ind, i]);
          end;
        def_road:
          begin
            roadBmps[ind, i] := TBmp.Create;
            roadBmps[ind, i].assign(Bmp);
            Bmptrans(roadBmps[ind, i]);
          end;
      end;
    end;

  except // if failed then Set Colored mode
    FreeAndNil(defwraper);
  end;
  FreeAndNil(defwraper);
  FreeAndNil(Bmp);
end; }

procedure Init(acanv: TDevice; aHeight, aWidth: word);
begin
  wndCanv := acanv;
  WndWidth := aWidth;
  WndHeight := aHeight;
end;

procedure Render({hDest, }hcanvas: THandle);
begin
  Assert(wndcanv <> 0, strRedrawError);
  bitblt(wndcanv{.handle}, 0, 0, WndWidth, WndHeight, hCanvas, 0, 0, SRCCOPY);
end;

//------------------------------------------------------------------------------

procedure Bmptrans(aBmp: TBmp; atransCol: Cardinal = transCol);
begin
  aBmp.Transparent := true;
  aBmp.TransparentColor := atransCol;
end;

//------------------------------------------------------------------------------

function flip(const b: TBmp; ver, hor: boolean): TBmp;
var
  hd: Hbitmap;
  wd, hg: Integer;
begin
  Result := b;
  if not (hor or ver) then
    Exit;
  hd := b.canvas.handle;
  wd := b.Width;
  hg := b.Height;
  if hor then
    stretchblt(hd, 0, hg - 1, hg, -hg, hd, 0, 0, wd, hg, srccopy);
  if ver then
    stretchblt(hd, wd - 1, 0, -wd, wd, hd, 0, 0, wd, hg, srccopy);

end;

function MatchCol(rgbt: trgbtriple; Col: TColor): Boolean;
begin
  Result := (rgbt.rgbtRed = GetRValue(Col)) and
    (rgbt.rgbtGreen = GetGValue(Col)) and
    (rgbt.rgbtBlue = GetBValue(Col));
end;

procedure copyrect(canvdest, canvsrc: TCanvas; rectdest, rectsrc: TRect);
begin
  Assert((canvdest <> nil) or (canvsrc <> nil), strRedrawError);
  bitblt(canvdest.handle, rectdest.Left, rectdest.Top, rectdest.Right -
    rectdest.Left, rectdest.Bottom - rectdest.Top, canvsrc.Handle, rectsrc.Left,
    rectsrc.Top, SRCCOPY);
end;

end.

